home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 8 / The Arsenal Files Collection #8 (Arsenal Computer) (1996).ISO / prg_basi / pa16v305.zip / TEST40.FRM < prev    next >
Text File  |  1996-05-11  |  7KB  |  293 lines
  1. VERSION 4.00
  2. Begin VB.Form TestForm 
  3.    Caption         =   "This is a test project for Project Analyzer"
  4.    ClientHeight    =   1080
  5.    ClientLeft      =   1095
  6.    ClientTop       =   1485
  7.    ClientWidth     =   5160
  8.    BeginProperty Font 
  9.       name            =   "MS Sans Serif"
  10.       charset         =   0
  11.       weight          =   700
  12.       size            =   8.25
  13.       underline       =   0   'False
  14.       italic          =   0   'False
  15.       strikethrough   =   0   'False
  16.    EndProperty
  17.    ForeColor       =   &H80000008&
  18.    Height          =   1485
  19.    Icon            =   "TEST40.frx":0000
  20.    Left            =   1035
  21.    LinkTopic       =   "Form1"
  22.    ScaleHeight     =   1080
  23.    ScaleWidth      =   5160
  24.    Top             =   1140
  25.    Width           =   5280
  26.    Begin VB.PictureBox Picture1 
  27.       Height          =   495
  28.       Left            =   3180
  29.       MouseIcon       =   "TEST40.frx":030A
  30.       MousePointer    =   99  'Custom
  31.       Picture         =   "TEST40.frx":074C
  32.       ScaleHeight     =   435
  33.       ScaleWidth      =   555
  34.       TabIndex        =   4
  35.       Top             =   60
  36.       Width           =   615
  37.    End
  38.    Begin VB.DriveListBox Drive1 
  39.       Height          =   315
  40.       Left            =   1140
  41.       MouseIcon       =   "TEST40.frx":14CE
  42.       MousePointer    =   99  'Custom
  43.       TabIndex        =   3
  44.       Top             =   660
  45.       Width           =   2475
  46.    End
  47.    Begin VB.ListBox List1 
  48.       Height          =   645
  49.       ItemData        =   "TEST40.frx":1910
  50.       Left            =   60
  51.       List            =   "TEST40.frx":191D
  52.       MouseIcon       =   "TEST40.frx":1939
  53.       MousePointer    =   99  'Custom
  54.       TabIndex        =   2
  55.       Top             =   360
  56.       Width           =   915
  57.    End
  58.    Begin VB.CommandButton Quit 
  59.       Appearance      =   0  'Flat
  60.       BackColor       =   &H80000005&
  61.       Caption         =   "Quit"
  62.       Height          =   330
  63.       Left            =   3780
  64.       TabIndex        =   0
  65.       Top             =   630
  66.       Width           =   1275
  67.    End
  68.    Begin VB.Image Image2 
  69.       Appearance      =   0  'Flat
  70.       Height          =   240
  71.       Left            =   4320
  72.       Picture         =   "TEST40.frx":1A8B
  73.       Top             =   120
  74.       Width           =   240
  75.    End
  76.    Begin VB.Image Image1 
  77.       Appearance      =   0  'Flat
  78.       Height          =   240
  79.       Left            =   3960
  80.       Picture         =   "TEST40.frx":1B8D
  81.       Top             =   120
  82.       Width           =   240
  83.    End
  84.    Begin VB.Label Label1 
  85.       Appearance      =   0  'Flat
  86.       BackColor       =   &H80000005&
  87.       BackStyle       =   0  'Transparent
  88.       Caption         =   "This program will not do anything"
  89.       ForeColor       =   &H80000008&
  90.       Height          =   225
  91.       Left            =   210
  92.       TabIndex        =   1
  93.       Top             =   90
  94.       Width           =   3000
  95.    End
  96. End
  97. Attribute VB_Name = "TestForm"
  98. Attribute VB_Creatable = False
  99. Attribute VB_Exposed = False
  100. ' A test project for Project Analyzer
  101. ' (C)1996 MyCompany Ltd.
  102. ' This is the form of the main screen
  103. ' This file also includes some important database routines
  104.  
  105. DefStr W
  106.  
  107. Public DatabaseName$
  108. Dim Weekdays(0 To 6)
  109.  
  110. ' Project Analyzer doesn't understand MAX_BUTTONS isn't dead
  111. Const MAX_BUTTONS = 50
  112. Dim Button(0 To MAX_BUTTONS) As CommandButton
  113.  
  114. Dim FName As String
  115. ' This is a module-level variable that overrides the
  116. ' global variable FName in Test40.bas
  117. Public FName2 As String
  118. ' This is a completely legal declaration in VB 4.0
  119. ' There is already a Public FName2 declared in Test40.bas
  120. ' This is another one
  121.  
  122.  
  123. ' Dim and Private mean the same here
  124. Dim TestObject As TestClass
  125. Private AnotherTestObject As New TestClass
  126.  
  127. Private Sub CloseDatabase()
  128. ' Close the database
  129. ' Check that all information is up-to-date
  130.  
  131. ReDim Preserve Button(0 To MAX_BUTTONS / 2) As CommandButton
  132.  
  133. End Sub
  134.  
  135. Private Function ExtensionOnly(ByVal File As String) As String
  136. ' Returns file name extension "BAS"
  137. ' This is a module-level function that will override
  138. ' the global function ExtensionOnly defined in FILETEST.BAS
  139.  
  140. ExtensionOnly = Right(File, 3)
  141.  
  142. End Function
  143.  
  144. Private Function Fibonacci(ByVal n As Integer)
  145. ' Sample of a recursive call sequence
  146. ' This function is only called by SumFibonacci
  147. ' but not by any other procedure
  148. ' -> Fibonacci and SumFibonacci are dead code
  149.  
  150. If n = 1 Then
  151.     Fibonacci = 1
  152. ElseIf n = 2 Then
  153.     Fibonacci = 1
  154. Else
  155.     Fibonacci = SumFibonacci(n - 1, n - 2)
  156. End If
  157.  
  158. End Function
  159.  
  160. Private Sub Form_Load()
  161. ' Start of the program
  162.  
  163. Set Button(0) = Quit
  164. Set TestObject = New TestClass
  165. Dim TestObject2 As TestClass
  166.  
  167. Set TestObject2 = TestObject
  168.  
  169. ' This is a reference to Property Let Value in TestClass
  170. TestObject2.Value = 18
  171.  
  172. ' These are 1) a reference to Property Let Value
  173. ' and 2) a reference to Property Get Value in TestClass
  174. TestObject2.Value = TestObject2.Value + 1
  175.  
  176. ReadINIFile
  177. OpenDB
  178. RunTheProgram
  179.  
  180. End Sub
  181.  
  182. Private Sub Form_Unload(Cancel As Integer)
  183. ' Quit the program
  184. ' First close the database
  185.  
  186. Set TestObject = Nothing
  187.  
  188. CloseDatabase
  189. End
  190.  
  191. End Sub
  192.  
  193. Private Sub OpenDB()
  194. ' Opening the DB
  195. ' Check for user rights
  196. ' Lock appropriate tables
  197.  
  198. ' Now we reference ExtensionOnly in this file
  199. If ExtensionOnly(FName) = "TXT" Then
  200.     '
  201. ' Then we reference ExtensionOnly in FileTest
  202. ElseIf FileModule.ExtensionOnly(FName) = "TXT" Then
  203. ElseIf IsDir("C:\WINDOWS") Then
  204.     If DriveType("C:", Drive1) <> DRIVE_FIXED Then
  205.         ' Panic
  206.     Else
  207.         ' Don't panic
  208.     End If
  209. End If
  210.  
  211. End Sub
  212.  
  213. Private Sub Image1_Click()
  214. ' This procedure tests the With statement
  215.  
  216. Const Value = 88
  217. With TestObject
  218.     ' Reference a property and a local const
  219.     .Value = .Value + Value
  220.     ' Call TestClass.ShowPublicHello
  221.     .ShowPublicHello
  222.     ' Call TestForm.ShowPublicHello
  223.     ShowPublicHello
  224. End With
  225.  
  226. ' Another with statement
  227. With Me
  228.     ' Call TestForm.ShowPublicHello again
  229.     .ShowPublicHello
  230. End With
  231.  
  232.  
  233. End Sub
  234.  
  235.  
  236. Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  237.  
  238. If Button > 1 Then AnotherTestObject.ShowPublicHello
  239.  
  240. End Sub
  241.  
  242.  
  243. Private Sub Quit_Click()
  244.  
  245. Unload Me
  246.  
  247. End Sub
  248.  
  249. Private Sub ReadINIFile()
  250. ' Read the configuration in PROJTEST.INI
  251. ' Note: If PROJTEST.INI doesn't exist, use defaults
  252.  
  253. IsThere = IsFile("PROJTEST.INI")
  254.  
  255. End Sub
  256.  
  257. Private Sub RunTheProgram()
  258. ' Run the program only if there is at least 1 MB free
  259. ' disk space
  260. ' Otherwise show error message
  261.  
  262. If DiskSpaceFree("C:") < 1024 ^ 2 Then
  263. End If
  264.  
  265. End Sub
  266.  
  267. Private Function SumFibonacci(a, b)
  268. ' Sample of a recursive call sequence
  269. ' This function is only called by Fibonacci
  270. ' but not by any other procedure
  271. ' -> Fibonacci and SumFibonacci are dead code
  272.  
  273. SumFibonacci = Fibonacci(a) + Fibonacci(b)
  274.  
  275. End Function
  276.  
  277. Public Sub Blink()
  278. Attribute Blink.VB_Description = "This sub changes the background color\r\nof the form"
  279.  
  280. BackColor = &HFF00FF
  281.  
  282. End Sub
  283.  
  284.  
  285. Public Sub ShowPublicHello()
  286. ' This sub is here to assure that Project Analyzer
  287. ' can make difference between
  288. ' TestClass.ShowPublicHello and TestForm.ShowPublicHello
  289.  
  290. MsgBox "Hellos from TestForm too!"
  291.  
  292. End Sub
  293.